home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Mac Format 1995 June
/
MacFormat 25.iso
/
Shareware City
/
Developers
/
fortran-to-c-translator-11
/
Mac F2C 1.1
/
Test Project ƒ
/
test.c (C Output)
< prev
next >
Wrap
Text File
|
1994-12-19
|
16KB
|
525 lines
/* test.f -- translated by f2c (version 19941113).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "f2c.h"
/* Table of constant values */
static integer c__9 = 9;
static integer c__1 = 1;
static integer c__10 = 10;
static integer c__3 = 3;
static integer c__4 = 4;
static integer c__5 = 5;
/* Main program */ MAIN__(void)
{
/* Format strings */
static char fmt_99[] = "(a1)";
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(void), s_rsfe(cilist *), do_fio(integer *, char *, ftnlen),
e_rsfe(void);
/* Subroutine */ int s_stop(char *, ftnlen);
/* Local variables */
char junk[2];
extern /* Subroutine */ int i_o_test__(void), flt_test__(integer *),
int_test__(integer *), trn_test__(void);
/* Fortran I/O blocks */
static cilist io___1 = { 0, 6, 0, 0, 0 };
static cilist io___2 = { 0, 6, 0, 0, 0 };
static cilist io___3 = { 0, 5, 0, fmt_99, 0 };
static cilist io___5 = { 0, 6, 0, 0, 0 };
static cilist io___6 = { 0, 6, 0, 0, 0 };
static cilist io___7 = { 0, 5, 0, fmt_99, 0 };
static cilist io___8 = { 0, 6, 0, 0, 0 };
static cilist io___9 = { 0, 6, 0, 0, 0 };
static cilist io___10 = { 0, 5, 0, fmt_99, 0 };
static cilist io___11 = { 0, 6, 0, 0, 0 };
static cilist io___12 = { 0, 6, 0, 0, 0 };
static cilist io___13 = { 0, 5, 0, fmt_99, 0 };
static cilist io___14 = { 0, 6, 0, 0, 0 };
static cilist io___15 = { 0, 6, 0, 0, 0 };
static cilist io___16 = { 0, 6, 0, 0, 0 };
static cilist io___17 = { 0, 6, 0, 0, 0 };
static cilist io___18 = { 0, 6, 0, 0, 0 };
/* This is a FORTRAN program to test Mac F2C v1.1 */
s_wsle(&io___1);
do_lio(&c__9, &c__1, "***** Input/Output Test *****", 33L);
e_wsle();
i_o_test__();
s_wsle(&io___2);
do_lio(&c__9, &c__1, "\n***** End of I/O test, hit return to continue."
"..", 51L);
e_wsle();
s_rsfe(&io___3);
do_fio(&c__1, junk, 2L);
e_rsfe();
s_wsle(&io___5);
do_lio(&c__9, &c__1, "\n***** Integer Math Test *****", 34L);
e_wsle();
int_test__(&c__10);
s_wsle(&io___6);
do_lio(&c__9, &c__1, "\n***** End of integer math test, hit return to "
"continue...", 60L);
e_wsle();
s_rsfe(&io___7);
do_fio(&c__1, junk, 2L);
e_rsfe();
s_wsle(&io___8);
do_lio(&c__9, &c__1, "\n***** Floating Point Math Test *****", 41L);
e_wsle();
flt_test__(&c__10);
s_wsle(&io___9);
do_lio(&c__9, &c__1, "\n***** End of floating point math test, hit ret"
"urn to continue...", 67L);
e_wsle();
s_rsfe(&io___10);
do_fio(&c__1, junk, 2L);
e_rsfe();
s_wsle(&io___11);
do_lio(&c__9, &c__1, "\n***** Transcendental Function Test *****",
45L);
e_wsle();
trn_test__();
s_wsle(&io___12);
do_lio(&c__9, &c__1, "\n***** End of transcendental function test, hit"
" return to continue...", 71L);
e_wsle();
s_rsfe(&io___13);
do_fio(&c__1, junk, 2L);
e_rsfe();
s_wsle(&io___14);
do_lio(&c__9, &c__1, "##################################################"
"########################", 74L);
e_wsle();
s_wsle(&io___15);
do_lio(&c__9, &c__1, " If you noticed that floating point values did not"
" round correctly when", 71L);
e_wsle();
s_wsle(&io___16);
do_lio(&c__9, &c__1, " displayed, please read the enclosed file \"If Flo"
"ats Don't Display Right\"", 73L);
e_wsle();
s_wsle(&io___17);
do_lio(&c__9, &c__1, "##################################################"
"########################", 74L);
e_wsle();
s_wsle(&io___18);
do_lio(&c__9, &c__1, "\n***** This completes all of the tests *****",
48L);
e_wsle();
s_stop("", 0L);
return 0;
} /* MAIN__ */
/**************************************************************************/
/* Subroutine to do the I/O tests */
/**************************************************************************/
/* Subroutine */ int i_o_test__(void)
{
/* Format strings */
static char fmt_399[] = "(a1)";
static char fmt_304[] = "(5x,a20,5(i1,2x),5x,5(f4.2,2x))";
/* System generated locals */
olist o__1;
cllist cl__1;
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(void), s_rsle(cilist *), e_rsle(void), s_rsfe(cilist *),
do_fio(integer *, char *, ftnlen), e_rsfe(void);
void s_copy(char *, char *, ftnlen, ftnlen);
integer f_open(olist *), s_wsue(cilist *), do_uio(integer *, char *,
ftnlen), e_wsue(void), f_clos(cllist *), s_wsfe(cilist *), e_wsfe(
void), s_rsue(cilist *), e_rsue(void);
/* Local variables */
char text[40];
real a[5];
integer i, j[5];
real x;
doublereal dx;
/* Fortran I/O blocks */
static cilist io___19 = { 0, 6, 0, 0, 0 };
static cilist io___20 = { 0, 5, 0, 0, 0 };
static cilist io___22 = { 0, 6, 0, 0, 0 };
static cilist io___23 = { 0, 6, 0, 0, 0 };
static cilist io___24 = { 0, 5, 0, 0, 0 };
static cilist io___26 = { 0, 6, 0, 0, 0 };
static cilist io___27 = { 0, 6, 0, 0, 0 };
static cilist io___28 = { 0, 5, 0, 0, 0 };
static cilist io___30 = { 0, 6, 0, 0, 0 };
static cilist io___31 = { 0, 6, 0, 0, 0 };
static cilist io___32 = { 0, 5, 0, 0, 0 };
static cilist io___34 = { 0, 6, 0, 0, 0 };
static cilist io___35 = { 0, 6, 0, 0, 0 };
static cilist io___36 = { 0, 5, 0, fmt_399, 0 };
static cilist io___39 = { 0, 60, 0, 0, 0 };
static cilist io___40 = { 0, 6, 0, 0, 0 };
static cilist io___41 = { 0, 6, 0, fmt_304, 0 };
static cilist io___42 = { 0, 50, 0, 0, 0 };
static cilist io___43 = { 0, 6, 0, 0, 0 };
static cilist io___44 = { 0, 6, 0, fmt_304, 0 };
/* Screen I/O tests */
s_wsle(&io___19);
do_lio(&c__9, &c__1, "\nPart 1: Screen I/O tests.\n\nEnter an integer v"
"alue.", 52L);
e_wsle();
s_rsle(&io___20);
do_lio(&c__3, &c__1, (char *)&i, (ftnlen)sizeof(integer));
e_rsle();
s_wsle(&io___22);
do_lio(&c__9, &c__1, "The number you entered was:", 27L);
do_lio(&c__3, &c__1, (char *)&i, (ftnlen)sizeof(integer));
e_wsle();
s_wsle(&io___23);
do_lio(&c__9, &c__1, "\nEnter a single precision floating point value...",
49L);
e_wsle();
s_rsle(&io___24);
do_lio(&c__4, &c__1, (char *)&x, (ftnlen)sizeof(real));
e_rsle();
s_wsle(&io___26);
do_lio(&c__9, &c__1, "The number you entered was: ", 28L);
do_lio(&c__4, &c__1, (char *)&x, (ftnlen)sizeof(real));
e_wsle();
s_wsle(&io___27);
do_lio(&c__9, &c__1, "\nEnter a double precision floating point value...",
49L);
e_wsle();
s_rsle(&io___28);
do_lio(&c__5, &c__1, (char *)&dx, (ftnlen)sizeof(doublereal));
e_rsle();
s_wsle(&io___30);
do_lio(&c__9, &c__1, "The number you entered was: ", 28L);
do_lio(&c__5, &c__1, (char *)&dx, (ftnlen)sizeof(doublereal));
e_wsle();
s_wsle(&io___31);
do_lio(&c__9, &c__1, "\nEnter some text (40 char max)...", 33L);
e_wsle();
s_rsle(&io___32);
do_lio(&c__9, &c__1, text, 40L);
e_rsle();
s_wsle(&io___34);
do_lio(&c__9, &c__1, "The text you entered was: ", 26L);
do_lio(&c__9, &c__1, text, 40L);
e_wsle();
s_wsle(&io___35);
do_lio(&c__9, &c__1, "\nPart 2: file I/O tests. Hit return to continue"
"...", 52L);
e_wsle();
s_rsfe(&io___36);
do_fio(&c__1, text, 40L);
e_rsfe();
/* File I/O tests: Store some values and write them to file */
for (i = 1; i <= 5; ++i) {
j[i - 1] = i;
a[i - 1] = (doublereal) i;
}
s_copy(text, "A test message.", 40L, 15L);
o__1.oerr = 0;
o__1.ounit = 60;
o__1.ofnmlen = 8;
o__1.ofnm = "test.dat";
o__1.orl = 0;
o__1.osta = 0;
o__1.oacc = 0;
o__1.ofm = "unformatted";
o__1.oblnk = 0;
f_open(&o__1);
s_wsue(&io___39);
do_uio(&c__1, text, 40L);
do_uio(&c__5, (char *)&j[0], (ftnlen)sizeof(integer));
do_uio(&c__5, (char *)&a[0], (ftnlen)sizeof(real));
e_wsue();
cl__1.cerr = 0;
cl__1.cunit = 60;
cl__1.csta = 0;
f_clos(&cl__1);
s_wsle(&io___40);
do_lio(&c__9, &c__1, "Wrote the following data to file test.dat:\n", 43L);
e_wsle();
s_wsfe(&io___41);
do_fio(&c__1, text, 40L);
for (i = 1; i <= 5; ++i) {
do_fio(&c__1, (char *)&j[i - 1], (ftnlen)sizeof(integer));
}
for (i = 1; i <= 5; ++i) {
do_fio(&c__1, (char *)&a[i - 1], (ftnlen)sizeof(real));
}
e_wsfe();
/* Reset the variables and read them back */
for (i = 1; i <= 5; ++i) {
j[i - 1] = 99;
a[i - 1] = 99.f;
}
s_copy(text, "reset", 40L, 5L);
o__1.oerr = 0;
o__1.ounit = 50;
o__1.ofnmlen = 8;
o__1.ofnm = "test.dat";
o__1.orl = 0;
o__1.osta = 0;
o__1.oacc = 0;
o__1.ofm = "unformatted";
o__1.oblnk = 0;
f_open(&o__1);
s_rsue(&io___42);
do_uio(&c__1, text, 40L);
do_uio(&c__5, (char *)&j[0], (ftnlen)sizeof(integer));
do_uio(&c__5, (char *)&a[0], (ftnlen)sizeof(real));
e_rsue();
cl__1.cerr = 0;
cl__1.cunit = 50;
cl__1.csta = 0;
f_clos(&cl__1);
s_wsle(&io___43);
do_lio(&c__9, &c__1, "\nRead the following data from file test.dat:\n",
45L);
e_wsle();
s_wsfe(&io___44);
do_fio(&c__1, text, 40L);
for (i = 1; i <= 5; ++i) {
do_fio(&c__1, (char *)&j[i - 1], (ftnlen)sizeof(integer));
}
for (i = 1; i <= 5; ++i) {
do_fio(&c__1, (char *)&a[i - 1], (ftnlen)sizeof(real));
}
e_wsfe();
return 0;
} /* i_o_test__ */
/**************************************************************************/
/* Subroutine to do the integer math tests */
/**************************************************************************/
/* Subroutine */ int int_test__(integer *m)
{
/* Format strings */
static char fmt_203[] = "(10x,\002n\002,5x,\002n^2\002,5x,\002n^3\002,"
"5x,\002n/2\002,3x,\002n^2/2\002,3x,\002n^3/2\002)";
static char fmt_202[] = "(5x,6(i6,2x))";
/* System generated locals */
integer i__1, i__2, i__3, i__4;
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(void), s_wsfe(cilist *), e_wsfe(void), do_fio(integer *,
char *, ftnlen);
/* Local variables */
integer i, j, k;
/* Fortran I/O blocks */
static cilist io___45 = { 0, 6, 0, 0, 0 };
static cilist io___46 = { 0, 6, 0, fmt_203, 0 };
static cilist io___50 = { 0, 6, 0, fmt_202, 0 };
s_wsle(&io___45);
do_lio(&c__9, &c__1, "\nGenerate a table of integers, squares, cubes, an"
"d their halves.\n", 65L);
e_wsle();
s_wsfe(&io___46);
e_wsfe();
i__1 = *m;
for (i = 1; i <= i__1; ++i) {
/* Computing 2nd power */
i__2 = i;
j = i__2 * i__2;
/* Computing 3rd power */
i__2 = i, i__3 = i__2;
k = i__3 * (i__2 * i__2);
s_wsfe(&io___50);
do_fio(&c__1, (char *)&i, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
i__2 = i / 2;
do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer));
i__3 = j / 2;
do_fio(&c__1, (char *)&i__3, (ftnlen)sizeof(integer));
i__4 = k / 2;
do_fio(&c__1, (char *)&i__4, (ftnlen)sizeof(integer));
e_wsfe();
}
return 0;
} /* int_test__ */
/**************************************************************************/
/* Subroutine to do the floating point math tests */
/**************************************************************************/
/* Subroutine */ int flt_test__(integer *m)
{
/* Format strings */
static char fmt_205[] = "(12x,\002x\002,6x,\002x^2\002,6x,\002x^3\002,"
"6x,\002x/2\002,4x,\002x^2/2\002,4x,\002x^3/2\002)";
static char fmt_201[] = "(5x,6(f8.2,1x))";
/* System generated locals */
integer i__1;
real r__1, r__2, r__3;
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(void), s_wsfe(cilist *), e_wsfe(void), do_fio(integer *,
char *, ftnlen);
/* Local variables */
integer i;
real x1, x2, x3;
/* Fortran I/O blocks */
static cilist io___51 = { 0, 6, 0, 0, 0 };
static cilist io___52 = { 0, 6, 0, fmt_205, 0 };
static cilist io___57 = { 0, 6, 0, fmt_201, 0 };
s_wsle(&io___51);
do_lio(&c__9, &c__1, "\nGenerate a table of floats, their squares, cubes"
", and their halves.\n", 69L);
e_wsle();
s_wsfe(&io___52);
e_wsfe();
i__1 = *m;
for (i = 1; i <= i__1; ++i) {
x1 = i * 1.f;
/* Computing 2nd power */
r__1 = x1;
x2 = r__1 * r__1;
/* Computing 3rd power */
r__1 = x1, r__2 = r__1;
x3 = r__2 * (r__1 * r__1);
s_wsfe(&io___57);
do_fio(&c__1, (char *)&x1, (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&x2, (ftnlen)sizeof(real));
do_fio(&c__1, (char *)&x3, (ftnlen)sizeof(real));
r__1 = x1 / 2;
do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
r__2 = x2 / 2;
do_fio(&c__1, (char *)&r__2, (ftnlen)sizeof(real));
r__3 = x3 / 2;
do_fio(&c__1, (char *)&r__3, (ftnlen)sizeof(real));
e_wsfe();
}
return 0;
} /* flt_test__ */
/**************************************************************************/
/* Subroutine to do the transcendental function tests */
/**************************************************************************/
/* Subroutine */ int trn_test__(void)
{
/* Format strings */
static char fmt_207[] = "(9x,\002x\002,10x,\002sin(x)\002,8x,\002cos(x"
")\002,3x,\002sin(x)^2 + cos(x)^2\002)";
static char fmt_200[] = "(5x,i2,\002*pi/6\0023x,f11.8,3x,f11.8,3x,f15.10)"
;
static char fmt_299[] = "(a1)";
static char fmt_208[] = "(11x,\002x\002,16x,\002log(x)\002,9x,\002exp(lo"
"g(x))\002)";
static char fmt_201[] = "(5x,f13.10,5x,f13.10,5x,f13.10)";
/* System generated locals */
doublereal d__1;
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(void), s_wsfe(cilist *), e_wsfe(void);
double sin(doublereal), cos(doublereal);
integer do_fio(integer *, char *, ftnlen), s_rsfe(cilist *), e_rsfe(void);
double log(doublereal), exp(doublereal);
/* Local variables */
char junk[2];
doublereal c;
integer i;
doublereal s, x, c2, s2, pi;
/* Fortran I/O blocks */
static cilist io___59 = { 0, 6, 0, 0, 0 };
static cilist io___60 = { 0, 6, 0, 0, 0 };
static cilist io___61 = { 0, 6, 0, fmt_207, 0 };
static cilist io___68 = { 0, 6, 0, fmt_200, 0 };
static cilist io___69 = { 0, 6, 0, 0, 0 };
static cilist io___70 = { 0, 5, 0, fmt_299, 0 };
static cilist io___72 = { 0, 6, 0, 0, 0 };
static cilist io___73 = { 0, 6, 0, fmt_208, 0 };
static cilist io___74 = { 0, 6, 0, fmt_201, 0 };
pi = 3.141592653589793f;
s_wsle(&io___59);
do_lio(&c__9, &c__1, "\nPart 1: Trig Functions", 23L);
e_wsle();
s_wsle(&io___60);
do_lio(&c__9, &c__1, "\nGenerate a table of x, sin(x), cos(x) and the su"
"m of their squares.\n", 69L);
e_wsle();
s_wsfe(&io___61);
e_wsfe();
for (i = 1; i <= 12; ++i) {
x = i * pi / 6.f;
s = sin(x);
c = cos(x);
/* Computing 2nd power */
d__1 = s;
s2 = d__1 * d__1;
/* Computing 2nd power */
d__1 = c;
c2 = d__1 * d__1;
s_wsfe(&io___68);
do_fio(&c__1, (char *)&i, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&s, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&c, (ftnlen)sizeof(doublereal));
d__1 = s2 + c2;
do_fio(&c__1, (char *)&d__1, (ftnlen)sizeof(doublereal));
e_wsfe();
}
s_wsle(&io___69);
do_lio(&c__9, &c__1, "\nPart 2: Exponential functions; hit return to co"
"ntinue...", 58L);
e_wsle();
s_rsfe(&io___70);
do_fio(&c__1, junk, 2L);
e_rsfe();
s_wsle(&io___72);
do_lio(&c__9, &c__1, "Generate a table of x, log(x), and exp(log(x))\n",
47L);
e_wsle();
s_wsfe(&io___73);
e_wsfe();
for (i = 1; i <= 10; ++i) {
x = (doublereal) i;
s = log(x);
c = exp(s);
s_wsfe(&io___74);
do_fio(&c__1, (char *)&x, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&s, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&c, (ftnlen)sizeof(doublereal));
e_wsfe();
}
return 0;
} /* trn_test__ */
/* Main program alias */ int test_f2c__ () { MAIN__ (); return 0; }